#lang racket


(require "misc.rkt")


(provide m.rotate
         m.scale
         m.translate
         
         m.line
         m.column
         
         -m
         m+m
         m-m
         m*m
         
         m.zero
         m.identity
         
         list<-matrix
         vector<-matrix)


(define (v*v l c)
  (foldl + 0 (vector->list (vector-map * l c))))


(define (matrix-print m port mode)  
  (define (print-line v)
    (write-string
     (string-join
      (vector->list
       (vector-map (λ (e) (format "~a" e)) v))
      " ")
     port))
  
  (write-string "m(" port)
  (print-line (vector-copy (matrix-vals m) 0 4))
  (newline port)
  
  (write-string "  " port)
  (print-line (vector-copy (matrix-vals m) 4 8))
  (newline port)
  
  (write-string "  " port)
  (print-line (vector-copy (matrix-vals m) 8 12))
  (newline port)
  
  (write-string "  " port)
  (print-line (vector-copy (matrix-vals m) 12 16))
  (write-string ")" port))

(define-struct matrix
  (vals)
  #:property prop:custom-write matrix-print)

(define (m.rotate a x y z)
  (error 'm.rotate "Not implemented"))

(define (m.scale x y z)
  (make-matrix
   (vector x 0 0 0
           0 y 0 0
           0 0 z 0
           0 0 0 1)))

(define (m.translate x y z)
  (make-matrix
   (vector 1 0 0 x
           0 1 0 y
           0 0 1 z
           0 0 0 1)))


(define (m.line m l)
  (vector-copy (matrix-vals m) (* l 4) (+ (* l 4) 4)))

(define (m.column m c)
  (let ((vals (matrix-vals m)))
    (vector
     (vector-ref vals c)
     (vector-ref vals (+ c 4))
     (vector-ref vals (+ c 8))
     (vector-ref vals (+ c 12)))))


(define (-m m)
  (make-matrix
   (vector-append
    (vector-map - (vector-copy (matrix-vals m) 0 12))
    (vector 0 0 0 1))))

(define (m+m m1 m2)
  (let ((vals1 (vector-take (matrix-vals m1) 12))
        (vals2 (vector-take (matrix-vals m2) 12)))
    (make-matrix
     (vector-append
      (vector-map + vals1 vals2)
      (vector 0 0 0 1)))))

(define (m-m m1 m2)
  (m+m m1 (-m m2)))

(define (m*m m1 m2)
  (make-matrix
   (list->vector
    (flatten
     (for/list ((i (range 4)))
       (for/list ((j (range 4)))
         (v*v (m.line m1 i) (m.column m2 j))))))))


(define m.zero
  (make-matrix
   (vector 0 0 0 0
           0 0 0 0
           0 0 0 0
           0 0 0 0)))

(define m.identity
  (m.scale 1 1 1))


(define (list<-matrix m)
  (vector->list (matrix-vals m)))

(define (vector<-matrix m)
  (vector-copy (matrix-vals m)))